Author: “Udday Datta”
Date: “3/21/2021”
For the data source please check this link
The analysis will show the link between the rise in annual temperature with the changing rainfall intensity. It will also explore the changing temperature trends in different regions and visualize the adverse climatic events like heavy rainfall in Bangladesh.
#Install all library
library(dplyr) # provides a set of tools for efficiently manipulating data sets in R
library(ggplot2) # data visualization package
library(plotly) # provides online graphing, analytics, and statistics tools
library("RColorBrewer") #color palettes
library(choroplethrZip) # for regional map of Bangladesh
library(choroplethr)
library(choroplethrAdmin1)
library(choroplethrMaps)
library(ggthemes)
# Carbon footprint and economic status of a country
library(tmap)
data(World, metro, land)
## Most of the world population lives near coastal areas.
## This makes a majority of population vulnerable to the impact of climate change.
tm_shape(land) +
tm_raster("elevation", palette = terrain.colors(10)) +
tm_shape(World) +
tm_borders("white", lwd = .5) +
tm_text("iso_a3", size = "AREA") +
tm_shape(metro) +
tm_symbols(col = "red", size = "pop2020", scale = .5) +
tm_legend(show = FALSE)
## Text size will be constant in view mode. Set tm_view(text.size.variable = TRUE) to enable variable text sizes.
## Legend for symbol sizes not available in view mode.
## Most of the developing countries have a lower carbon footprint,
###but they are facing the worst impact of global warming.
tmap_mode("view")
## tmap mode set to interactive viewing
tm_shape(World) +
tm_polygons(c("footprint", "economy")) +
tm_facets(sync = TRUE, ncol = 2)
# Bangladesh is also not an exception.
Bangladesh = subset(World, name == "Bangladesh")
tmap_mode("view")
## tmap mode set to interactive viewing
tm_shape(Bangladesh) +
tm_polygons(c("footprint", "economy")) +
tm_facets(sync = TRUE, ncol = 2)
# Administrative regions of Bangladesh
data("admin1.map")
bangladesh = subset(admin1.map, admin == "bangladesh")
bd_map <- ggplot(bangladesh) + geom_polygon(aes(long, lat, fill= region, group = group),
color = "black") + theme_map() + coord_fixed(1.1)+
ggtitle("Regional Map of Bangladesh")
plot(bd_map)

knitr::opts_chunk$set(echo = TRUE)
## The original data was modified to match the region name in the previous map.
## All Station Names were converted to their region name.
climate_change <- read.csv(file = "Weather Data Bangladesh (1948 - 2013).csv",TRUE, sep = ",", stringsAsFactors = FALSE)
str(climate_change)
## 'data.frame': 21120 obs. of 18 variables:
## $ SL : int 0 1 2 3 4 5 6 7 8 9 ...
## $ region : chr "borishal" "borishal" "borishal" "borishal" ...
## $ YEAR : int 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 ...
## $ Month : int 1 1 1 1 1 1 1 1 1 1 ...
## $ Max.Temp : num 29.4 30 28.2 26.6 30 27.8 26.6 29.4 30.1 31.1 ...
## $ Min.Temp : num 12.3 14.1 12.3 12.3 13.3 12.7 12.3 14.3 15.1 15.5 ...
## $ Rainfall : num 0 0 0 2 10 0 2 17 104 0 ...
## $ Relative.Humidity: num 68 77 77 77 75 72 77 74 80 77 ...
## $ Wind.Speed : num 0.454 0.454 0.454 0.454 0.454 ...
## $ Cloud.Coverage : num 0.6 0.8 0.6 1 1.6 0.5 1 0.4 1 1.7 ...
## $ Bright.Sunshine : num 7.83 7.83 7.83 7.83 7.83 ...
## $ Station.Number : int 41950 41950 41950 41950 41950 41950 41950 41950 41950 41950 ...
## $ X_COR : num 536810 536810 536810 536810 536810 ...
## $ Y_COR : num 510152 510152 510152 510152 510152 ...
## $ LATITUDE : num 22.7 22.7 22.7 22.7 22.7 22.7 22.7 22.7 22.7 22.7 ...
## $ LONGITUDE : num 90.4 90.4 90.4 90.4 90.4 ...
## $ ALT : int 4 4 4 4 4 4 4 4 4 4 ...
## $ Period : num 1949 1950 1951 1952 1953 ...
head(climate_change)
knitr::opts_chunk$set(echo = TRUE)
#Bar Plot
climate_change_chart <- ggplot(climate_change, aes(x = YEAR , y = Relative.Humidity, fill = Max.Temp)) +
xlab("Year") +
ylab("Relative Humidity") +
theme_minimal(base_size = 14) + scale_fill_viridis_c()
barplot <- climate_change_chart +
geom_bar( position = "dodge", stat = "identity",color= "white")
ggplotly(barplot)
# From the bar plot, we can see temperature has increases in last few decades, also there is a sharp
## contrast in humidity change suggesting sudden heavy rain and extreme weather.
climate_change_chart2 <- ggplot(climate_change, aes(x = YEAR , y = Rainfall , fill = Max.Temp )) +
xlab("Year") +
ylab("Rainfall") +
theme_minimal(base_size = 14)+ scale_fill_viridis_c()
barplot2 <- climate_change_chart2 +
geom_bar( position = "dodge", stat = "identity",color= "white")
ggplotly(barplot2)
# From the bar plot, we can see rainfall intensity has increases in last few decades
knitr::opts_chunk$set(echo = TRUE)
library(lubridate)
## Warning: package 'lubridate' was built under R version 4.0.5
##
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union
# adding Year-Month variable as date
climate_change_ymd <- climate_change %>%
mutate(year_month = ymd(paste(climate_change$YEAR, climate_change$Month, truncated = 1)))
Min_t1 <- ggplot(climate_change_ymd, aes(year_month, Min.Temp, color = region)) +
geom_line() +
geom_smooth(se=FALSE, linetype = "dotted") +
labs(title = "Minimum Temperature (1949-2013)",
x = "Year",
y = "Minimum Temperature") +
theme(plot.title = element_text(hjust = 0.5))
ggplotly(Min_t1)
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
Max_t1 <- ggplot(climate_change_ymd, aes(year_month, Max.Temp, color = region)) +
geom_line() +
geom_smooth(se=FALSE, linetype = "dotted") +
labs(title = "Maximum Temperature (1949-2013)",
x = "Year",
y = "Maximum Temperature") +
theme(plot.title = element_text(hjust = 0.5))
ggplotly(Max_t1)
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## We can see the increase in temperature was relatively high in Dhaka Division
## As Dhaka is the capital, it has seen an intense urbanization in recent years aiding to the increased temperature.
knitr::opts_chunk$set(echo = TRUE)
Min_t2 <- ggplot(climate_change, aes(as.factor(Month), Min.Temp)) +
geom_point(aes(color = as.factor(YEAR))) +
geom_line(aes(group = as.factor(YEAR),
color = as.factor(YEAR)),
alpha = 0.7) +
labs(title = 'Minimum Temperature by month') +
xlab("Months") +
ylab("Temperature") +
theme(axis.text.x = element_text(size = 6,angle = 90,hjust = 0.5, vjust = 0.5))
# theme(legend.position = "none")
ggplotly(Min_t2)
Max_t2 <- ggplot(climate_change, aes(as.factor(Month), Max.Temp)) +
geom_point(aes(color = as.factor(YEAR))) +
geom_line(aes(group = as.factor(YEAR),
color = as.factor(YEAR)),
alpha = 0.7) +
labs(title = 'Maximum Temperature by month') +
xlab("Months") +
ylab("Temperature") +
theme(axis.text.x = element_text(size = 6,angle = 90,hjust = 0.5, vjust = 0.5))
# theme(legend.position = "none")
ggplotly(Max_t2)
# We can see that the temperature has been steadily rising across years but this plot is little bit crowded,
# so a ‘Temperature-density’ distribution plot was created.
knitr::opts_chunk$set(echo = TRUE)
library(ggridges)
## Warning: package 'ggridges' was built under R version 4.0.4
Min_t3 <- ggplot(climate_change, aes(x = Min.Temp, y = as.factor(YEAR))) +
geom_density_ridges_gradient(aes(fill = ..x..),
scale = 3, size = 0.3, alpha = 0.5) +
scale_fill_gradientn(colours = c("#0D0887FF", "#CC4678FF", "#F0F921FF"),
name = "Temp") +
labs(title = 'Minimum Temperature density') +
theme(legend.position = c(0.9,0.2)) +
xlab("Temperature") +
ylab("Year")+theme_minimal(base_size = 10)
plot(Min_t3)
## Picking joint bandwidth of 1.44

Max_t3 <- ggplot(climate_change, aes(x = Max.Temp, y = as.factor(YEAR))) +
geom_density_ridges_gradient(aes(fill = ..x..),
scale = 3, size = 0.3, alpha = 0.5) +
scale_fill_gradientn(colours = c("#0D0887FF", "#CC4678FF", "#F0F921FF"),
name = "Temp") +
labs(title = 'Maximum Temperature density') +
theme(legend.position = c(0.9,0.2)) +
xlab("Temperature") +
ylab("Year")+theme_minimal(base_size = 10)
plot(Max_t3)
## Picking joint bandwidth of 0.77

## From the Temperature-density distribution, we can see how the minimum temperature has increase suggesting a higher overall temperature aiding to increased evaporation rate and chances of heavy rain.
Min_t4 <- ggplot(data = climate_change,
mapping = aes(x =Min.Temp,
xend=Min.Temp,
y = reorder(YEAR,Min.Temp))) + geom_dotplot(
aes(fill = ..x..)) + scale_fill_gradient(
low = "yellow",high = "red") +
labs(title = 'Changing Temperature Trends')
plot(Min_t4)
## `stat_bindot()` using `bins = 30`. Pick better value with `binwidth`.

## From the changing temperature trends, it can be observed that most of the hottest years were in last few decades. The minimum temperature also did not go below 10 degree Celsius a lot during this time.
knitr::opts_chunk$set(echo = TRUE)
library(ggiraph)
## Warning: package 'ggiraph' was built under R version 4.0.4
library(ggiraphExtra)
## Warning: package 'ggiraphExtra' was built under R version 4.0.4
##
## Attaching package: 'ggiraphExtra'
## The following object is masked from 'package:ggthemes':
##
## theme_clean
fit_max=lm(Max.Temp~Rainfall,data=climate_change)
summary(fit_max)
##
## Call:
## lm(formula = Max.Temp ~ Rainfall, data = climate_change)
##
## Residuals:
## Min 1Q Median 3Q Max
## -11.2446 -1.8591 0.1282 1.8429 10.8586
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.284e+01 2.576e-02 1274.73 <2e-16 ***
## Rainfall 3.208e-03 8.308e-05 38.62 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.886 on 21118 degrees of freedom
## Multiple R-squared: 0.06596, Adjusted R-squared: 0.06591
## F-statistic: 1491 on 1 and 21118 DF, p-value: < 2.2e-16
ggPredict(fit_max,se=TRUE,interactive=TRUE)
## Warning: package 'gdtools' was built under R version 4.0.4
fit_min=lm(Min.Temp~Rainfall,data=climate_change)
summary(fit_min)
##
## Call:
## lm(formula = Min.Temp ~ Rainfall, data = climate_change)
##
## Residuals:
## Min 1Q Median 3Q Max
## -19.5934 -3.0074 0.7515 3.1958 8.3510
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.870e+01 3.559e-02 525.4 <2e-16 ***
## Rainfall 1.240e-02 1.148e-04 108.0 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 3.987 on 21118 degrees of freedom
## Multiple R-squared: 0.356, Adjusted R-squared: 0.3559
## F-statistic: 1.167e+04 on 1 and 21118 DF, p-value: < 2.2e-16
ggPredict(fit_min,se=TRUE,interactive=TRUE)
## From the graphs, it is clearly visible that increased rainfall intensity is directly linked with rising temperature. The change in minimum temperature has a greater impact.
knitr::opts_chunk$set(echo = TRUE)
library(gganimate)
## Warning: package 'gganimate' was built under R version 4.0.4
library(magick)
## Warning: package 'magick' was built under R version 4.0.4
## Linking to ImageMagick 6.9.11.57
## Enabled features: cairo, freetype, fftw, ghostscript, heic, lcms, pango, raw, rsvg, webp
## Disabled features: fontconfig, x11
##
## Attaching package: 'magick'
## The following object is masked from 'package:ggiraphExtra':
##
## rose
Animation1 <- ggplot(climate_change, aes(YEAR, Rainfall, size = Min.Temp, colour = Month, group = Month)) +
geom_point(alpha = 0.2, show.legend = FALSE) +
facet_wrap(~Month) +
labs(title = 'Year: {frame_time}', x = 'Year', y = 'Rainfall') +
transition_time(YEAR) +
ease_aes('linear')
animate(Animation1, height = 500, width= 500, fps = 25, duration = 8,
end_pause = 20, res = 100, renderer = magick_renderer())

anim_save("rain1.gif")
## The changing climate and its impact on rain intensity is explained through this animation. The change in rain intensity is visualized throughout the monthly change in rainfall from year 1949 to 2013.
p <- ggplot(climate_change, aes(x = YEAR, y = Rainfall, color = Month, group = Month)) +
geom_path() +
geom_point() +
facet_wrap(~ Month) +
theme(legend.position = 'none') +
labs(title = ' Rainfall Variation, Year: {frame_along}') +
transition_reveal(along = YEAR) +
ease_aes('linear')
animate(p, height = 500, width= 500, fps = 25, duration = 8,
end_pause = 20, res = 100, renderer = magick_renderer())

anim_save("rain2.gif")
knitr::opts_chunk$set(echo = TRUE)